home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 27 (1992-03)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip / MegaDisc 27 (1992-03)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf / Programming / Basic_Routines / BasicSubs / demos / Ltd_Input.demo < prev    next >
Text File  |  1992-03-30  |  4KB  |  160 lines

  1. SCREEN 1,640,250,4,2
  2. WINDOW 2,"                            LIMITED INPUT DEMO",,0,1
  3. GOSUB LOADCOLOURS
  4. GOSUB SCREENSETUP
  5. COLOR 0,12
  6. RESPONSELOOP:
  7.   GOSUB GETRESPONSE
  8.   IF response=4 THEN SYSTEM
  9.   ON response GOSUB NUMERIC,CAPITALS,ANYTHING:GOTO RESPONSELOOP
  10.  
  11. NUMERIC:
  12.   maxlen=8:xinp=15:yinp=7:GOSUB GETNUMBER
  13.   GOSUB PRINTRESPONSE
  14.   RETURN
  15.   
  16. CAPITALS:
  17.   maxlen=8:xinp=57:yinp=7:GOSUB GETINPUT
  18.   GOSUB PRINTRESPONSE
  19.   RETURN
  20.  
  21. ANYTHING:
  22.   maxlen=8:xinp=36:yinp=15:GOSUB GETANYTHING
  23.   GOSUB PRINTRESPONSE
  24.   RETURN
  25.  
  26. PRINTRESPONSE:
  27.   deft=8-LEN(default$):default$=default$+LEFT$("        ",deft)
  28.   LOCATE yinp,xinp:PRINT default$
  29.   RETURN
  30.                 
  31. LOADCOLOURS:
  32.   OPEN "BasicUtils&Subs:SetupFiles/Colours" FOR INPUT AS #1
  33.   FOR i = 0 TO 15
  34.   INPUT #1,a,b,C,C$
  35.   PALETTE i,a,b,C
  36.   NEXT i
  37.   CLOSE
  38.   RETURN
  39.   
  40. SCREENSETUP:
  41.   xs=59:ys=19:xe=235:ye=59:fillcol=12:olcol=2:GOSUB RAISED
  42.   xs=397:xe=573:GOSUB RAISED
  43.   xs=227:ys=83:xe=397:ye=123:GOSUB RAISED
  44.   COLOR 0,12
  45.   LOCATE 4,10:PRINT "Press This Box For":LOCATE 5,10:PRINT "Numeric Input Only"
  46.   LOCATE 7,15:PRINT "________"
  47.   LOCATE 4,52:PRINT "Press This Box For":LOCATE 5,52:PRINT "Capital Letter Only"
  48.   LOCATE 7,57:PRINT "________"
  49.   LOCATE 12,31:PRINT "Press This Box For":LOCATE 13,31:PRINT "Any Limited Input"
  50.   LOCATE 15,36:PRINT "________"
  51.   xs=267:xe=357:ys=163:ye=179:fillcol=6:GOSUB RAISED
  52.   COLOR 0,6:LOCATE 22,38:PRINT "QUIT"
  53.   RETURN
  54.   
  55. RAISED:
  56.   COLOR olcol
  57.   LINE (xs,ys)-(xe,ye),,b
  58.   LINE (xs-4,ys-2)-(xe+4,ye+2),,b
  59.   LINE (xs-2,ys-1)-(xe+2,ye+1),,b
  60.   GOSUB FILLBOX
  61.   RETURN
  62.   
  63. FILLBOX:
  64.   COLOR fillcol
  65.   LINE (xs+1,ys+1)-(xe-1,ye-1),,b
  66.   PAINT ((xs+xe)/2,(ys+ye)/2)
  67.   RETURN
  68.  
  69. GETINPUT:
  70.   a$="":b$="":inplen=0
  71.   LOCATE yinp,xinp:PRINT "|";:FOR i = 2 TO maxlen:PRINT "_";:NEXT i
  72.   LOCATE yinp,xinp
  73.   a$=INKEY$
  74.   IF a$=CHR$(27) THEN default$=a$:RETURN
  75.   IF a$>"`" AND a$<"{" THEN a$=CHR$(ASC(a$)-32)
  76.   IF a$ = CHR$(13) THEN RETURN
  77.   IF a$<"A" OR a$>"Z" THEN GOTO GETINPUT
  78. GETLINE:
  79.   b$ = b$+a$:inplen=inplen+1:PRINT a$;
  80.   IF inplen = maxlen THEN default$=b$:RETURN
  81.   PRINT "|";:LOCATE yinp,xinp+inplen
  82. GETKEY:
  83.   a$=INKEY$ 
  84.   IF a$=CHR$(27) THEN default$=a$:RETURN
  85.   IF a$>"`" AND a$<"{"THEN a$=CHR$(ASC(a$)-32)
  86.   IF a$ >"@" AND a$<"[" OR a$=" " THEN GOTO GETLINE
  87.   IF a$=CHR$(13) THEN default$=b$:RETURN
  88.   IF a$=CHR$(8) THEN
  89.     inplen=inplen-1:IF inplen=0 THEN GETINPUT
  90.     b$=LEFT$(b$,inplen)
  91.     LOCATE yinp,xinp:PRINT b$;"|_":LOCATE yinp,xinp+inplen
  92.   END IF  
  93.   GOTO GETKEY        
  94.  
  95. GETNUMBER:
  96.   a$="":b$="":inplen=0
  97.   LOCATE yinp,xinp:PRINT  "|";:FOR i=2 TO maxlen:PRINT "_";:NEXT i
  98.   LOCATE yinp,xinp
  99.   a$=INKEY$
  100.   IF a$=CHR$(27) THEN default$=a$:RETURN
  101.   IF a$ = CHR$(13) THEN RETURN
  102.   IF (a$<"0" OR a$>"9") AND a$<> "." THEN GOTO GETNUMBER
  103. GETNUM:
  104.   b$=b$+a$:inplen=inplen+1:PRINT  a$;
  105.   IF inplen = maxlen THEN default$=b$:RETURN
  106.   PRINT "|";:LOCATE yinp,xinp+inplen
  107. GETKEYNUM:
  108.   a$=INKEY$
  109.   IF a$=CHR$(27) THEN default$=a$:RETURN
  110.   IF (a$>"/" AND a$<":") OR a$="." THEN GOTO GETNUM
  111.   IF a$= CHR$(13) THEN default$=b$:RETURN
  112.   IF a$= CHR$(8) THEN
  113.     inplen=inplen-1: IF inplen =0 THEN GETNUMBER
  114.     b$ = LEFT$(b$,inplen)
  115.     LOCATE yinp,xinp:PRINT b$;"|_":LOCATE yinp,xinp+inplen
  116.   END IF
  117.   GOTO GETKEYNUM
  118.  
  119. GETANYTHING:
  120.   a$="":b$="":inplen=0
  121.   LOCATE yinp,xinp:PRINT "|";:FOR i = 2 TO maxlen:PRINT "_";:NEXT i
  122.   LOCATE yinp,xinp
  123.   a$=INKEY$
  124.   IF a$=CHR$(27) THEN default$=a$:RETURN
  125.   IF a$ = CHR$(13) THEN RETURN
  126.   IF a$<" " OR a$>"~" THEN GOTO GETANYTHING
  127. GETANYLINE:
  128.   b$ = b$+a$:inplen=inplen+1:PRINT a$;
  129.   IF inplen = maxlen THEN default$=b$:RETURN
  130.   PRINT "|";:LOCATE yinp,xinp+inplen
  131. GETANYKEY:
  132.   a$=INKEY$ 
  133.   IF a$=CHR$(27) THEN default$=a$:RETURN
  134.   IF a$ > CHR$(31) AND a$< CHR$(127) THEN GOTO GETANYLINE
  135.   IF a$=CHR$(13) THEN default$=b$:RETURN
  136.   IF a$=CHR$(8) THEN
  137.     inplen=inplen-1:IF inplen=0 THEN GETANYTHING
  138.     b$=LEFT$(b$,inplen)
  139.     LOCATE yinp,xinp:PRINT b$;"|_":LOCATE yinp,xinp+inplen
  140.   END IF  
  141.   GOTO GETANYKEY        
  142.  
  143. GETRESPONSE:
  144.   response=0
  145.   ON MOUSE GOSUB LEFTMOUSE
  146.   MOUSE ON
  147. NORESPONSE:
  148.   IF response = 0 THEN NORESPONSE
  149.   RETURN
  150.          
  151. LEFTMOUSE:
  152.   IF MOUSE(0)=0 THEN RETURN
  153.   x=MOUSE(3):Y=MOUSE(4)
  154.   IF (x>59 AND x<235 AND Y>19 AND Y<59) THEN response = 1:RETURN
  155.   IF (x>397 AND x<573 AND Y>19 AND Y<59) THEN response = 2:RETURN
  156.   IF (x>227 AND x<397 AND Y>83 AND Y<123) THEN response = 3:RETURN
  157.   IF (x>267 AND x<357 AND Y>163 AND Y<179) THEN response = 4:RETURN
  158.   RETURN 
  159.  
  160.